home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / os2 / pvm34b3.zip / pvm34b3 / pvm3 / examples / hitc.f < prev    next >
Text File  |  1997-07-22  |  3KB  |  94 lines
  1. c
  2. c $Id: hitc.f,v 1.1 1996/09/23 20:55:30 pvmsrc Exp $
  3. c
  4.       program hitc_master
  5.       include '../include/fpvm3.h'
  6. c ---------------------------------------------------------
  7. c HiTc master program. Gets user input. spawns tasks.
  8. c Uses pool-of-tasks dynamic load balancing
  9. c ---------------------------------------------------------
  10.       integer i, info, nhost, narch, msgtype, n, negr
  11.       integer mytid, tids(0:32)
  12.       integer who, idummy
  13.       double precision random
  14.       character*12 hostname
  15.       character*8 arch
  16.  
  17. c ------------ Starting up all the tasks ---------------------------
  18.  
  19. c     Enroll this program in PVM 
  20.       call pvmfmytid( mytid )
  21.  
  22. c     Find out how many hosts are in virtual machine
  23. c     Start one hitc_slave task on each one.
  24.       call pvmfconfig( nhost, narch, idummy, hostname, arch,
  25.      >                 idummy, info )
  26. c
  27.       print *, nhost,' hosts detected in configuration'
  28.       call pvmfspawn( 'hitc_slave', PVMDEFAULT, '*', nhost, tids, info )
  29.       if( info .lt. nhost ) then
  30.         print *,'Error in spawn. info=', info
  31.         do 100 i=0, nproc-1
  32.            print *,'tid',i,tids(i)
  33. 100     continue
  34.       endif
  35.  
  36. c     Set Problem size relative to virtual machine size
  37. c     Number of energies per task
  38.       negr = 10
  39. c     Initial problem size
  40.       n = 140
  41.  
  42. c     Broadcast data to all node programs 
  43.       call pvmfinitsend( PVMDEFAULT, info )
  44.       call pvmfpack( INTEGER4, n, 1, 1, info )
  45.       msgtype  = 1 
  46.       call pvmfmcast( nhost, tids, msgtype, info )
  47.  
  48. c     Size of the job pool
  49.       numleft = nhost*negr-nhost 
  50.  
  51. c     wait for results from nodes 
  52.       do 30 i=1,nhost*negr
  53.          msgtype  = 2 
  54.          call pvmfrecv( -1, msgtype, info ) 
  55.          call pvmfunpack( INTEGER4, who, 1, 1, info )
  56.          print *,'I got result from tid:',who
  57. c        Send more work to this idle task
  58.          if( numleft .gt. 0 ) then
  59.            n = 130 + 10*random()
  60.          else
  61.            n = -1
  62.          endif
  63.          call pvmfinitsend( PVMDEFAULT, info )
  64.          call pvmfpack( INTEGER4, n, 1, 1, info )
  65.          msgtype  = 1
  66.          call pvmfsend( who, msgtype, info )
  67.          print *,'sent ',who,' task of size:',n
  68.          numleft = numleft - 1
  69.  30   continue 
  70.  
  71. c     program finished leave PVM before exiting 
  72.       print *,'Program Finished'
  73.       call pvmfexit(info) 
  74.       stop
  75.       end
  76.  
  77. c-----------------------------------------------------------------------------
  78.       double precision function random()
  79.  
  80. c-----------------------------------------------------
  81. c  Routine returns a pseudo-random number between 0-1. 
  82. c-----------------------------------------------------
  83.       integer m, i, md, seed
  84.       double precision fmd
  85.  
  86.       data m/25173/,i/13849/,md/65536/,fmd/65536.d0/,seed/17/
  87.  
  88.       save seed
  89.  
  90.       seed   = mod(m*seed+i,md)
  91.       random = seed/fmd
  92.       return
  93.       end
  94.